Baraj, Sibiu august 1996, Ziua 1 
Problema 2 (Evadatul - Dana Lica)
Dificultate: C4

Un  prizonier al unei inchisori a reusit sa evadeze cu ajutorul unui complice 
care i-a trimis si un plan al str(zilor din oraa. Complicele il asteapta cu o 
masina intr-una din intersectiile orasului, pe care a marcat-o pe harta. 
Pe acest plan complet al strazilor si intersectiilor, sunt marcate distinct 
acele intersectii in care se afl posturile de control ale poliTiei locale, cat 
si punctul de plecare al proaspatului evadat (care se afla tot la o intersectie 
de strazi). Pe harta mai sunt marcati si timpii necesari pentru strabaterea 
fiecarei str(zi. Evadatul stie ca in drumul sau catre complice are voie sa 
intalneasca maxim m posturi de control. Altfel, la al m+1-lea post va fi prins,
deoarece el are la dispozitie numai m grenade pentru neutralizarea acestor 
puncte de control.
Sa se determine drumul pe care evadatul trebuie sa-l strabata ca sa ajunga in 
timpul cel mai scurt de la locul in care se afla, pana la complice. In cazul 
in care exista mai multe drumuri cu acelasi timp minim de strabatere, evadatul 
il va alege pe cel cu numar minim de puncte de control. 
Pe harta intersectiile sunt numerotate cu numere de la 1 la n, considerandu-se 
intersectia numarul 1 cea din care pleaca evadatul, si intersectia numarul n 
cea in care se afla complicele.
 	Fisierul de intrare al carui nume se citeste de la tastatura, are 
urmatoarea forma:
n		-numar de intersectii, n<50
s		-numar de str(zi
i1 j1 c1	-timpul c1 necesar pentru strabaterea strazii aflate intre 
intersectiile i1 si j1
i2 j2 c2	-timpul c2 necesar pentru strabaterea strazii aflate intre 
intersectiile i2 si j2
...
is js cs	-timpul cs necesar pentru strabaterea strazii aflate intre 
intersectiile is si js
p		-numarul de posturi de control
o1 o2 ..op	-lista intersectiilor an care se afla puncte de control
m		-numarul de grenade m<10 si contine numai valori naturale.
Fisierul de iesire va avea numele "drum.txt"  si va contine pe prima linie 
intersectiile aflate pe drumul cerut, iar pe linia a doua timpul necesar 
parcurgerii acestuia si numarul de puncte de control intalnite.
Datele de pe fiecare linie a fisierului de iesire vor fi despartite prin exact 
un spatiu.
In cazul in care nu exista un astfel de drum, fisierul de iesire va contine 
mesajul
EVADAT CAPTURAT
Exemplu:
Fisierul de intrare
8
13
1 2 4
1 3 1
1 4 11
2 3 2
2 5 5
3 4 15
3 5 1
3 6 2
4 7 3
5 6 4
5 8 30
6 7 1
7 8 3
3
3 6 7
2
Fisierul de iesire:
1 4 7 8
17 1
=========================================
Testul 1:
15
21
1 2 21
1 5 1
2 3 31
2 4 14
3 4 17
3 10 11
4 6 20
5 6 7
5 7 2
6 9 13
6 11 2
7 8 1
7 13 25
8 9 5
8 12 1
10 12 10
11 14 5
12 13 1
13 14 1
13 15 17
14 15 3
8
3 5 7 8 9 11 12 14
3
-------------------------
testul 2:
9
15
1 2 5
1 3 4
1 4 2
2 3 17
2 5 1
2 7 12
3 4 2
3 5 2
4 6 15
5 6 2
5 7 2
5 8 1
6 9 1
7 9 1
8 9 2
4
3 4 5 6
4
------------------------
Testul 3:
32
46
1 2 1
1 3 1
2 4 1
2 5 1
3 6 1
3 7 1
4 15 1
4 14 1
5 13 1
5 12 1
6 11 1
6 10 1
7 9 1
7 8 1
15 16 1
15 17 1
14 18 1
14 19 1
13 20 1
13 21 1
12 22 1
12 23 1
11 24 1
11 25 1
10 26 1
10 27 1
9 28 1
9 29 1
8 30 1
8 31 1
16 32 1
17 32 1
18 32 1
19 32 1
20 32 1
21 32 1 
22 32 1
23 32 1
24 32 1
25 32 1
26 32 1
27 32 1
28 32 1
29 32 1
30 32 1
31 32 1
28
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
2
--------------------------------------------
Testul 4:
49
58
1 2 5
1 3 4
1 5 3
2 6 12
2 7 5
2 22 17
3 8 3
4 5 5
4 9 4
5 17 1
5 13 7
6 7 13
6 23 10
7 8 5
7 22 14
7 38 5
8 20 4
9 18 1
9 19 7
10 17 3
10 28 2
11 12 10
11 16 11
13 15 9
14 15 3
14 31 2
15 16 5
16 29 10
17 35 1
17 28 1
18 27 1
20 26 3
21 22 5
23 39 5
24 39 4
25 39 3
26 37 1
27 36 1
30 31 4
30 34 5
32 46 15
33 46 5
33 34 4
35 45 1
36 43 2
36 44 3
37 43 2
38 49 6
39 41 4
40 41 7
42 43 1
42 49 3
43 49 17
44 49 3
45 49 4
45 46 10
46 47 10
47 48 4
12
5 7 8 9 13 17 30 35 33 43 45 47
3
-----------------------------
testul 5:
9
14
1 2 3
1 4 5
1 3 4
2 3 4
2 4 5
3 4 5
5 6 7
5 7 8
5 8 9
6 8 9
7 8 9
7 9 10
8 9 10
4
1 3 5 7
3 
------------------------
testul 6:
9
15
1 2 5
1 3 4
1 4 2
2 3 17
2 5 1
2 7 12
3 4 2
3 5 2
4 6 15
5 6 2
5 7 2
5 8 1
6 9 1
7 9 1
8 9 2
6
1 3 4 5 6 9
6
----------------------------
raspuns testul 1:
1 5 6 11 14 15
18 3
----------------------
Raspuns testul 2:
1 2 5 7 9
9 1

sau

1 2 5 8 9
9 1
--------------------------
Raspuns testul 3:
EVADAT CAPTURAT
--------------------------
raspuns testul 4:
1 2 7 38 49
21 1
------------------------
raspuns testul 5:
EVADAT CAPTURAT
----------------------------
raspuns testul 6:
1 2 5 7 9
9 3
---------------------
Solutie 1 (Dana Lica)
const max=50;
type tab=array[1..max,1..max]of real;
var d:tab;nume:string;
    f:text;n,s,np,i,j,k,m,mink:integer;c,min:real;
    o,e:array[1..max]of boolean;
    sm,ss:array[1..max]of integer ;ns:byte;
procedure back(i:byte);
var j:byte;
begin
     if i=n then begin
                  if (c<min)or (c=min)and (k<mink) then begin min:=c;ss:=sm;mink:=k end;
                  exit
                 end;
     for j:=1 to n do
         if o[j] and not e[j] and (d[i,j]<1e37) then begin
            if k>m+1 then exit;
            inc(k);
            sm[k]:=j;c:=c+d[i,j];e[j]:=true;
            back(j);e[j]:=false;c:=c-d[i,j];dec(k);
            end;
end;
procedure drum(i,j:byte);
var k:byte;
begin
     for k:=1 to n do
         if not o[k]and(k<>i)and(k<>j)then
            if d[i,k]+d[k,j]=d[i,j]then begin
               drum(i,k);drum(k,j);exit
            end;
     write(j:2)
end;
procedure drumm;
begin
     for k:=1 to n do
         if not o[k] then
            for i:=1 to n do
                for j:=1 to n do
                    if d[i,k]+d[k,j]<d[i,j]
                       then d[i,j]:=d[i,k]+d[k,j];
end;
begin
     readln(nume);assign(f,nume);reset(f);
     readln(f,n);
     for i:=1 to n do for j:=1 to n do d[i,j]:=1e37;
     for i:=1 to n do d[i,i]:=0;
     readln(f,s);
     for k:=1 to s do begin
         readln(f,i,j,c);d[i,j]:=c;d[j,i]:=c
     end;
     readln(f,np);
     for k:=1 to np do begin
         read(f,i);o[i]:=true;
             end;
     readln(f,m);
     drumm;
     o[n]:=true;sm[1]:=1;c:=0;min:=1e37;mink:=n;
     k:=1;back(1);
     write(1);
     for j:=1 to mink-1 do drum(ss[j],ss[j+1]);
     writeln;
     writeln(min:4:0,mink-2:4);
end.
-------------------------------
Solutie 2 (Dana Lica)
const max=50;
type tab=array[1..max,1..max]of real;
var d:tab;nume:string;
    f:text;n,s,np,i,j,k,m,mink:integer;c,min:real;
    o,e:array[1..max]of boolean;
    sm,ss:array[1..max]of integer ;ns:byte;
procedure back(i:byte);
var j:byte;
begin
     if i=n then begin
                  if (c<min)or (c=min)and (k<mink) then begin min:=c;ss:=sm;mink:=k end;
                  exit
                 end;
     for j:=1 to n do
         if o[j] and not e[j] and (d[i,j]<1e37) then begin
            if k>m+1 then exit;
            inc(k);
            sm[k]:=j;c:=c+d[i,j];e[j]:=true;
            back(j);e[j]:=false;c:=c-d[i,j];dec(k);
            end;
end;
procedure drum(i,j:byte);
var k:byte;
begin
     for k:=1 to n do
         if not o[k]and(k<>i)and(k<>j)then
            if d[i,k]+d[k,j]=d[i,j]then begin
               drum(i,k);drum(k,j);exit
            end;
     write(j:2)
end;
procedure drumm;
begin
     for k:=1 to n do
         if not o[k] then
            for i:=1 to n do
                for j:=1 to n do
                    if d[i,k]+d[k,j]<d[i,j]
                       then d[i,j]:=d[i,k]+d[k,j];
end;
begin
     readln(nume);assign(f,nume);reset(f);
     readln(f,n);
     for i:=1 to n do for j:=1 to n do d[i,j]:=1e37;
     for i:=1 to n do d[i,i]:=0;
     readln(f,s);
     for k:=1 to s do begin
         readln(f,i,j,c);d[i,j]:=c;d[j,i]:=c
     end;
     readln(f,np);
     for k:=1 to np do begin
         read(f,i);o[i]:=true;
             end;
     readln(f,m);
     drumm;
     o[n]:=true;sm[1]:=1;c:=0;min:=1e37;mink:=n;
     k:=1;back(1);
     write(1);
     for j:=1 to mink-1 do drum(ss[j],ss[j+1]);
     writeln;
     writeln(min:4:0,mink-2:4);
end.
------------------------
Solutie 3 (Dana Lica)
const max=50;
type tab=array[1..max,1..max]of real;
var d:tab;nume:string;
    f:text;n,s,np,i,j,k,m,mink:integer;c,min:real;
    o,e:array[1..max]of boolean;
    sm,ss:array[1..max]of integer ;ns:byte;
procedure drum(i,j:byte);
var k:byte;
begin
     for k:=1 to n do
         if not o[k]and(k<>i)and(k<>j)then
            if d[i,k]+d[k,j]=d[i,j]then begin
               drum(i,k);drum(k,j);exit
            end;
     write(j:4)
end;
procedure back(i:byte);
var j:byte;
begin
     if i=n then begin
                  if (c<min)or (c=min)and (k<mink) then begin
                     min:=c;ss:=sm;mink:=k;
                     for j:=1 to mink-1 do drum(ss[j],ss[j+1]);
                     writeln('--->',min:6:0,mink-2:4)
                  end;
                  exit
                 end;
     for j:=1 to n do
         if o[j] and not e[j] and (d[i,j]<1e37) then begin
            if k>m+1 then exit;
            inc(k);
            sm[k]:=j;c:=c+d[i,j];e[j]:=true;
            back(j);e[j]:=false;c:=c-d[i,j];dec(k);
            end;
end;
procedure drumm;
begin
     for k:=1 to n do
         if not o[k] then
            for i:=1 to n do
                for j:=1 to n do
                    if d[i,k]+d[k,j]<d[i,j]
                       then d[i,j]:=d[i,k]+d[k,j];
end;
begin
     readln(nume);assign(f,nume);reset(f);
     readln(f,n);
     for i:=1 to n do for j:=1 to n do d[i,j]:=1e37;
     for i:=1 to n do d[i,i]:=0;
     readln(f,s);
     for k:=1 to s do begin
         readln(f,i,j,c);d[i,j]:=c;d[j,i]:=c
     end;
     readln(f,np);
     for k:=1 to np do begin
         read(f,i);o[i]:=true;
             end;
     readln(f,m);
     drumm;
     o[n]:=true;sm[1]:=1;c:=0;min:=1e37;mink:=n;
     k:=1;
     back(1);
     write(1);
     for j:=1 to mink-1 do drum(ss[j],ss[j+1]);
     writeln;
     writeln(min:4:0,mink-2:4);
end.
--------------------------
Solutia 4 (Mihai Stroe)
type ar=array[0..50,0..50]of longint;
     arr=array[1..3000,1..2]of longint;
var min,st,mp,en,i,j,k,l,m,n,p,nrg:longint;
    fi,fo:text;
    s:string;
    post:array[1..50]of longint;
    a,timp,tata:ar;
    c:arr;
    ps:set of byte;

procedure rec(i,j:longint);
var k:byte;
begin
  if i in ps then k:=1 else k:=0;
  if i=1 then begin write(fo,1);exit;end;
  rec(tata[i,j],j-k);
  write(fo,' ',i);
end;

procedure readdata;
begin
  fillchar(a,sizeof(a),127);
  write('Introduceti numele fisierului de intrare ');
  readln(s);
  assign(fi,s);
  reset(fi);
  readln(fi,n);
  readln(fi,m);
  for k:=1 to m do
      begin
        readln(fi,i,j,a[i,j]);
        a[j,i]:=a[i,j];
      end;
  readln(fi,p);
  for i:=1 to p do
      begin
        read(fi,post[i]);
        ps:=ps+[post[i]];
      end;
  readln(fi);
  readln(fi,nrg);
  close(fi);
end;

procedure solve;
begin
  for i:=1 to n+1 do
      for j:=0 to n do
          timp[i,j]:=60000;
  st:=1;
  en:=1;
  c[1,1]:=1;
  c[1,2]:=0;
  timp[1,0]:=0;
  tata[1,0]:=0;
  while st<=en do
    begin
      for i:=1 to n do
          begin
            if i in ps then k:=1 else k:=0;
            if a[c[st,1],i]+timp[c[st,1],c[st,2]]<timp[i,c[st,2]+k] then
               begin
                 timp[i,c[st,2]+k]:=a[c[st,1],i]+timp[c[st,1],c[st,2]];
                 tata[i,c[st,2]+k]:=c[st,1];
                 inc(en);
                 c[en,1]:=i;
                 c[en,2]:=c[st,2]+k;
               end;
          end;
      inc(st);
    end;
  min:=timp[n+1,1];mp:=-1;
  for i:=0 to nrg do
      if timp[n,i]<min then begin min:=timp[n,i];mp:=i;end;
  if min=60000 then begin writeln(fo,'EVADAT CAPTURAT');exit;end;
  rec(n,mp);
  writeln(fo);
  writeln(fo,timp[n,mp],' ',mp);
end;

begin
  assign(fo,'drum.txt');
  rewrite(fo);
  readdata;
  solve;
  close(fo);
end.
---------------------------
Solutia 5 (Ovidiu Gheorghioiu)
const nmax=50;
      mmax=10;

type  mat=array[1..nmax,1..nmax,0..mmax] of byte;

var a:array[1..nmax,1..nmax] of integer;
    c:array[1..nmax,1..nmax,0..mmax] of integer;
    kk:^mat;
    i,j,k,m,n,l,s,t,ss,min,mk:integer;
    f:text;
    nume:string;
    o:array[1..nmax] of byte;

procedure citeste;
begin
     write('Numele fisierului de intrare: ');readln(nume);
     assign(f,nume);reset(f);
     readln(f,n);
     fillchar(a,sizeof(a),$39);
     fillchar(c,sizeof(c),$39);
     readln(f,s);
     for k:=1 to s do begin
         readln(f,i,j,m);
         a[i,j]:=m;
         a[j,i]:=m
     end;
     readln(f,k);
     fillchar(o,sizeof(o),0);
     for i:=1 to k do begin
         read(f,j);
         o[j]:=1
     end;
     readln(f,m);
     close(f)
end;

procedure rezolva;
begin
     new(kk);
     fillchar(c,sizeof(c),$39);
     for j:=2 to n do begin
         c[1,j,o[j]+o[1]]:=a[1,j];kk^[1,j,o[j]+o[1]]:=j
     end;
     for i:=2 to n-1 do
         for j:=i+1 to n do begin
             c[i,j,o[j]]:=a[i,j];kk^[i,j,o[j]]:=j;
             c[j,i,o[i]]:=a[i,j];kk^[j,i,o[i]]:=i;
         end;
     for l:=0 to m do
         for i:=1 to n do
             for j:=1 to n do begin
                 min:=c[i,j,l];
                 mk:=kk^[i,j,l];
                 for t:=0 to (l+1) shr 1 do
                     for k:=1 to n do begin
                         ss:=c[i,k,t]+c[k,j,l-t];
                         if ss<min then begin
                            mk:=kk^[i,k,t];
                            min:=ss
                         end;
                     end;
                 c[i,j,l]:=min;
                 kk^[i,j,l]:=mk;
             end;
end;

procedure scrie;
begin
     min:=$3939;
     for k:=1 to m do
         if c[1,n,k]<min then begin
            min:=c[1,n,k];
            mk:=k
         end;
     k:=mk;
     i:=1;
     assign(f,'drum.txt');
     rewrite(f);
     if min=$3939 then writeln(f,'EVADAT CAPTURAT') else begin
        while i<>n do begin
              write(f,i,' ');
              if boolean(o[i]) then dec(k);
              i:=kk^[i,n,k];
        end;
        writeln(f,n);
        writeln(f,min,' ',mk)
     end;
     close(f);
end;

begin
     citeste;
     rezolva;
     scrie
end.
---------------------------------
Solutia 6 (Mihai Badoiu)
{$A+,B-,D-,E-,F-,G+,I-,L-,N+,O-,P-,Q-,R-,S-,T-,V+,X+,Y-}
{$M 16384,0,655360}
const
	max=64;
var
	n,p,m:integer;
	d:array[1..max,1..max] of byte;
	v:array[1..max,1..max] of integer;
	par:array[1..max,1..max] of byte;
	t:array[1..max] of boolean;

procedure load;
var
	f:text;
	nume:string;
	s:integer;
	i,a,b,c,k:integer;
begin
	write('fis = ');
	readln(nume);
	assign(f,nume);
	reset(f);
	readln(f,n);
	readln(f,s);
	for i:=1 to s do
	begin
		readln(f,a,b,c);
		d[a,b]:=c;
		end;
	readln(f,p);
	for i:=1 to p do
	begin
		read(f,k);
		t[k]:=true;
		end;
	readln(f);
	readln(f,m);
	close(f);
end;

procedure calcul;
var
	i,j,k,l:integer;
begin
{init}
	for i:=1 to n do
		for j:=1 to m+1 do
			v[i,j]:=maxint;
	v[1,1]:=0;
	for k:=1 to m+1 do
		for l:=1 to n do
		for i:=1 to n do
			if v[i,k]<>maxint then
			begin
				if t[i] then
				begin
					for j:=1 to n do
						if (d[i,j]<>0) and (v[j,k+1]>v[i,k]+d[i,j]) then
						begin
							v[j,k+1]:=v[i,k]+d[i,j];
							par[j,k+1]:=i;
							end;
					end
				else
				begin
					for j:=1 to n do
						if (d[i,j]<>0) and (v[j,k]>v[i,k]+d[i,j]) then
						begin
							v[j,k]:=v[i,k]+d[i,j];
							par[j,k]:=i;
							end;
					end;
				end;
end;

procedure scrie;
var
	fo:text;
	i,j,k,min:integer;
	x:array[1..max] of integer;
	virf:integer;
begin
	assign(fo,'drum.txt');
	rewrite(fo);
	min:=maxint;
	if t[n] then
		dec(m);
	for k:=1 to m+1 do
	if min>v[n,k] then
	begin
		min:=v[n,k];
		j:=k;
		end;
	k:=j;
	if min=maxint then
	begin
		writeln(fo,'EVADAT CAPTURAT');
		end
	else
	begin
		i:=n;
		virf:=0;
		while i<>1 do
		begin
			inc(virf);
			x[virf]:=i;
			i:=par[i,j];
			if t[i] then
				dec(j);
			end;
		write(fo,1);
		for i:=virf downto 1 do
		begin
			write(fo,' ',x[i]);
			end;
		writeln(fo);
		if t[n] then
			writeln(fo,min,' ',k)
		else
			writeln(fo,min,' ',k-1);
		end;
	close(fo);
end;

begin
	load;
	calcul;
	scrie;
end.
------------------------------------
Solutia 7 (Valentin Gheorghita)
program problema2;
uses crt;
var dr,a:array[1..50,1..50] of real;
    ta:array[1..50,1..50] of integer;
    t:array[1..50] of integer;
    d:array[1..50] of real;
    sel,post:array[1..50] of boolean;
    i,v,nr,j,k,l,m,n,u,cat,p,s:integer;
    po:array[1..10] of integer;
    min:real;
    f:text;
    nume:string;
    sol,car:array[1..10] of integer;

procedure drumeag(a,b:integer);
 var s:integer;
 begin
  write(f,a,' ');
  s:=a;
  while ta[b,s]<>b do begin
                         write(f,ta[b,s],' ');
                         s:=ta[b,s];
                        end;
 end;
procedure recurs(vf,poz:integer;lung:real);
 var i,j:integer;
 begin
  if poz<m then begin
  for i:=1 to p do
   if not(sel[po[i]]) and (dr[vf,po[i]]>0) then begin
                            poz:=poz+1;
                            car[poz]:=po[i];
                            sel[po[i]]:=true;
                            if ((lung+dr[vf,po[i]]+dr[po[i],n]<min) or
                               ((lung+dr[vf,po[i]]+dr[po[i],n]=min) and (nr>poz)))
                               and (dr[po[i],n]<>0) then begin
                                                                       min:=lung+dr[vf,po[i]]+dr[po[i],n];
                                                                       nr:=poz;
                                                                       for j:=1 to poz do
                                                                        sol[j]:=car[j];
                                                                      end;
                            recurs(po[i],poz,lung+dr[vf,po[i]]);
                            sel[po[i]]:=false;
                            poz:=poz-1;
                           end; end;
 end;

begin
 clrscr;
 write('Introduceti numele fisierului de intrare : '); readln(nume);
 assign(f,nume);
 reset(f);
 readln(f,n);
 readln(f,s);
 for i:=1 to n do
  for j:=1 to n do
   a[i,j]:=0;
 for i:=1 to s do
  begin
   readln(f,k,l,m);
   a[k,l]:=m;
   a[l,k]:=m;
  end;
 readln(f,p);
 for i:=1 to n do
  post[i]:=false;
 cat:=0;
 for i:=1 to p do
  begin
   read(f,j);
   post[j]:=true;
   if (j=1) or (j=n) then cat:=cat+1
                     else po[i-cat]:=j;
  end;
 readln(f,m);
 close(f);
 for v:=1 to n do
  begin
   for i:=1 to n do
    begin
     sel[i]:=false;
     d[i]:=0;
     t[i]:=0;
    end;
   sel[v]:=true;
   for i:=1 to n do
    if a[i,v]<>0 then begin
                       d[i]:=a[i,v];
                       t[i]:=v;
                      end;
   for k:=2 to n do
    begin
     min:=0;
     for i:=1 to n do
      if not(sel[i]) and (d[i]>0) and ((d[i]<min)or(min=0)) then begin
                                                              j:=i;
                                                              min:=d[i];
                                                             end;
     if not(post[j]) and (j<>i) and (j<>n) then
        for i:=1 to n do
         if ((d[i]>d[j]+a[i,j]) or (d[i]=0)) and (a[i,j]>0) then begin
                                   d[i]:=d[j]+a[i,j];
                                   t[i]:=j;
                                  end;
     sel[j]:=true;
    end;
  for i:=1 to n do
   begin
    dr[v,i]:=d[i];
    ta[v,i]:=t[i];
   end;
  end;
 p:=p-cat;
 if p<m then m:=p;
 for i:=1 to n do
  sel[i]:=false;
 min:=maxlongint;
 recurs(1,0,0);
 assign(f,'drum.txt');
 rewrite(f);
 if (dr[1,n]<min) and (dr[1,n]<>0) then begin
                      drumeag(1,n);
                      write(f,' ',n);
                      writeln(f);
                      writeln(f,dr[1,n]:0:2,' ',cat);
                      close(f);
                      halt;
                     end;
 if min=maxlongint then begin
                         writeln(f,'EVADAT CAPTURAT');
                         close(f);
                         halt;
                        end;
 drumeag(1,sol[1]);
 for i:=1 to nr-1 do
  drumeag(sol[i],sol[i+1]);
 drumeag(sol[nr],n);
 write(f,' ',n);
 writeln(f);
 writeln(f,min:0:2,' ',nr+cat);
 close(f);
end.
--------------------------
Solutia 8 (Mihai Stroe)

     Definim matricea A, cu semnificatia: A[i,j] este timpul minim in care
  evadatul poate ajunge in pozitia i folosind j grenade. Matricea se
  completeaza folosind o coada. Initial in coada se afla pozitia initiala,
  adica perechea (1,k), unde k=1 daca in 1 exista post de politie si k=0
  altfel. La fiecare pas se actualizeaza valorile din matricea A pentru
  descendentii primului element din coada; acestia sunt introdusi in coada,
  daca valoarea din A a fost optimizata, iar capul cozii avanseaza o pozitie
  (primul element este scos din coada).
    In final se cauta solutia, folosind ultima linie din matricea A; daca
  exista solutie, ea este afisata de o procedura recursiva.

type ar=array[0..50,0..50]of longint;
     arr=array[1..5000,1..2]of integer;
var ll,min,st,mp,en,i,j,k,l,m,n,p,nrg:longint;
    fi,fo:text;
    s:string;
    post:array[1..50]of longint;
    a,timp,tata:ar;
    c:arr;
    ps:set of byte;

procedure rec(i,j:longint);
var k:byte;
begin
  if i in ps then k:=1 else k:=0;
  if i=1 then begin write(fo,1);exit;end;
  rec(tata[i,j],j-k);
  write(fo,' ',i);
end;

procedure readdata;
begin
  fillchar(a,sizeof(a),127);
  write('Introduceti numele fisierului de intrare ');
  readln(s);
  assign(fi,s);
  reset(fi);
  readln(fi,n);
  readln(fi,m);
  for k:=1 to m do
      begin
        readln(fi,i,j,a[i,j]);
        a[j,i]:=a[i,j];
      end;
  readln(fi,p);
  for i:=1 to p do
      begin
        read(fi,post[i]);
        ps:=ps+[post[i]];
      end;
  readln(fi);
  readln(fi,nrg);
  close(fi);
end;

procedure solve;
begin
  for i:=1 to n+1 do
      for j:=0 to n do
          timp[i,j]:=60000;
  st:=1;
  en:=1;
  c[1,1]:=1;
  c[1,2]:=0;
  ll:=0;if 1 in ps then ll:=1;
  if 1 in ps then c[1,2]:=1;
  if ll=0 then timp[1,0]:=0 else timp[1,1]:=0;
  if ll=0 then tata[1,0]:=0 else tata[1,1]:=0;
  while st<=en do
    begin
      for i:=1 to n do
          begin
            if i in ps then k:=1 else k:=0;
            if a[c[st,1],i]+timp[c[st,1],c[st,2]]<timp[i,c[st,2]+k] then
               if c[st,2]+k<=m then
               begin
                 timp[i,c[st,2]+k]:=a[c[st,1],i]+timp[c[st,1],c[st,2]];
                 tata[i,c[st,2]+k]:=c[st,1];
                 inc(en);
                 c[en,1]:=i;
                 c[en,2]:=c[st,2]+k;
               end;
          end;
      inc(st);
    end;
  min:=timp[n+1,1];mp:=-1;
  for i:=0 to nrg do
      if timp[n,i]<min then begin min:=timp[n,i];mp:=i;end;
  if min=60000 then begin writeln(fo,'EVADAT CAPTURAT');exit;end;
  rec(n,mp);
  writeln(fo);
  writeln(fo,timp[n,mp],' ',mp);
end;

begin
  assign(fo,'drum.txt');
  rewrite(fo);
  readdata;
  solve;
  close(fo);
end.
------------------------------
